home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / Perl / bin / pod2man < prev    next >
Text File  |  1990-01-01  |  29KB  |  1,177 lines
  1. #!/gg/bin/perl
  2.     eval 'exec /gg/bin/perl -S $0 ${1+"$@"}'
  3.     if $running_under_some_shell;
  4.  
  5. $DEF_PM_SECTION = '3' || '3';
  6.  
  7. =head1 NAME
  8.  
  9. pod2man - translate embedded Perl pod directives into man pages
  10.  
  11. =head1 SYNOPSIS
  12.  
  13. B<pod2man>
  14. [ B<--section=>I<manext> ]
  15. [ B<--release=>I<relpatch> ]
  16. [ B<--center=>I<string> ]
  17. [ B<--date=>I<string> ]
  18. [ B<--fixed=>I<font> ]
  19. [ B<--official> ]
  20. [ B<--lax> ]
  21. I<inputfile>
  22.  
  23. =head1 DESCRIPTION
  24.  
  25. B<pod2man> converts its input file containing embedded pod directives (see
  26. L<perlpod>) into nroff source suitable for viewing with nroff(1) or
  27. troff(1) using the man(7) macro set.
  28.  
  29. Besides the obvious pod conversions, B<pod2man> also takes care of
  30. func(), func(n), and simple variable references like $foo or @bar so
  31. you don't have to use code escapes for them; complex expressions like
  32. C<$fred{'stuff'}> will still need to be escaped, though.  Other nagging
  33. little roffish things that it catches include translating the minus in
  34. something like foo-bar, making a long dash--like this--into a real em
  35. dash, fixing up "paired quotes", putting a little space after the
  36. parens in something like func(), making C++ and PI look right, making
  37. double underbars have a little tiny space between them, making ALLCAPS
  38. a teeny bit smaller in troff(1), and escaping backslashes so you don't
  39. have to.
  40.  
  41. =head1 OPTIONS
  42.  
  43. =over 8
  44.  
  45. =item center
  46.  
  47. Set the centered header to a specific string.  The default is
  48. "User Contributed Perl Documentation", unless the C<--official> flag is
  49. given, in which case the default is "Perl Programmers Reference Guide".
  50.  
  51. =item date
  52.  
  53. Set the left-hand footer string to this value.  By default,
  54. the modification date of the input file will be used.
  55.  
  56. =item fixed
  57.  
  58. The fixed font to use for code refs.  Defaults to CW.
  59.  
  60. =item official
  61.  
  62. Set the default header to indicate that this page is of
  63. the standard release in case C<--center> is not given.
  64.  
  65. =item release
  66.  
  67. Set the centered footer.  By default, this is the current
  68. perl release.
  69.  
  70. =item section
  71.  
  72. Set the section for the C<.TH> macro.  The standard conventions on
  73. sections are to use 1 for user commands,  2 for system calls, 3 for
  74. functions, 4 for devices, 5 for file formats, 6 for games, 7 for
  75. miscellaneous information, and 8 for administrator commands.  This works
  76. best if you put your Perl man pages in a separate tree, like
  77. F</usr/local/perl/man/>.  By default, section 1 will be used
  78. unless the file ends in F<.pm> in which case section 3 will be selected.
  79.  
  80. =item lax
  81.  
  82. Don't complain when required sections aren't present.
  83.  
  84. =back
  85.  
  86. =head1 Anatomy of a Proper Man Page
  87.  
  88. For those not sure of the proper layout of a man page, here's
  89. an example of the skeleton of a proper man page.  Head of the
  90. major headers should be setout as a C<=head1> directive, and
  91. are historically written in the rather startling ALL UPPER CASE
  92. format, although this is not mandatory.
  93. Minor headers may be included using C<=head2>, and are
  94. typically in mixed case.
  95.  
  96. =over 10
  97.  
  98. =item NAME
  99.  
  100. Mandatory section; should be a comma-separated list of programs or
  101. functions documented by this podpage, such as:
  102.  
  103.     foo, bar - programs to do something
  104.  
  105. =item SYNOPSIS
  106.  
  107. A short usage summary for programs and functions, which
  108. may someday be deemed mandatory.
  109.  
  110. =item DESCRIPTION
  111.  
  112. Long drawn out discussion of the program.  It's a good idea to break this
  113. up into subsections using the C<=head2> directives, like
  114.  
  115.     =head2 A Sample Subection
  116.  
  117.     =head2 Yet Another Sample Subection
  118.  
  119. =item OPTIONS
  120.  
  121. Some people make this separate from the description.
  122.  
  123. =item RETURN VALUE
  124.  
  125. What the program or function returns if successful.
  126.  
  127. =item ERRORS
  128.  
  129. Exceptions, return codes, exit stati, and errno settings.
  130.  
  131. =item EXAMPLES
  132.  
  133. Give some example uses of the program.
  134.  
  135. =item ENVIRONMENT
  136.  
  137. Envariables this program might care about.
  138.  
  139. =item FILES
  140.  
  141. All files used by the program.  You should probably use the FE<lt>E<gt>
  142. for these.
  143.  
  144. =item SEE ALSO
  145.  
  146. Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8).
  147.  
  148. =item NOTES
  149.  
  150. Miscellaneous commentary.
  151.  
  152. =item CAVEATS
  153.  
  154. Things to take special care with; sometimes called WARNINGS.
  155.  
  156. =item DIAGNOSTICS
  157.  
  158. All possible messages the program can print out--and
  159. what they mean.
  160.  
  161. =item BUGS
  162.  
  163. Things that are broken or just don't work quite right.
  164.  
  165. =item RESTRICTIONS
  166.  
  167. Bugs you don't plan to fix :-)
  168.  
  169. =item AUTHOR
  170.  
  171. Who wrote it (or AUTHORS if multiple).
  172.  
  173. =item HISTORY
  174.  
  175. Programs derived from other sources sometimes have this, or
  176. you might keep a modification log here.
  177.  
  178. =back
  179.  
  180. =head1 EXAMPLES
  181.  
  182.     pod2man program > program.1
  183.     pod2man some_module.pm > /usr/perl/man/man3/some_module.3
  184.     pod2man --section=7 note.pod > note.7
  185.  
  186. =head1 DIAGNOSTICS
  187.  
  188. The following diagnostics are generated by B<pod2man>.  Items
  189. marked "(W)" are non-fatal, whereas the "(F)" errors will cause
  190. B<pod2man> to immediately exit with a non-zero status.
  191.  
  192. =over 4
  193.  
  194. =item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s>
  195.  
  196. (W) If you start include an option, you should set it off
  197. as bold, italic, or code.
  198.  
  199. =item can't open %s: %s
  200.  
  201. (F) The input file wasn't available for the given reason.
  202.  
  203. =item Improper man page - no dash in NAME header in paragraph %d of %s
  204.  
  205. (W) The NAME header did not have an isolated dash in it.  This is
  206. considered important.
  207.  
  208. =item Invalid man page - no NAME line in %s
  209.  
  210. (F) You did not include a NAME header, which is essential.
  211.  
  212. =item roff font should be 1 or 2 chars, not `%s'  (F)
  213.  
  214. (F) The font specified with the C<--fixed> option was not
  215. a one- or two-digit roff font.
  216.  
  217. =item %s is missing required section: %s
  218.  
  219. (W) Required sections include NAME, DESCRIPTION, and if you're
  220. using a section starting with a 3, also a SYNOPSIS.  Actually,
  221. not having a NAME is a fatal.
  222.  
  223. =item Unknown escape: %s in %s
  224.  
  225. (W) An unknown HTML entity (probably for an 8-bit character) was given via
  226. a C<EE<lt>E<gt>> directive.  Besides amp, lt, gt, and quot, recognized
  227. entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave,
  228. Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute,
  229. Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc,
  230. icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc,
  231. ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig,
  232. THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml,
  233. Yacute, yacute, and yuml.
  234.  
  235. =item Unmatched =back
  236.  
  237. (W) You have a C<=back> without a corresponding C<=over>.
  238.  
  239. =item Unrecognized pod directive: %s
  240.  
  241. (W) You specified a pod directive that isn't in the known list of
  242. C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>.
  243.  
  244.  
  245. =back
  246.  
  247. =head1 NOTES
  248.  
  249. If you would like to print out a lot of man page continuously, you
  250. probably want to set the C and D registers to set contiguous page
  251. numbering and even/odd paging, at least on some versions of man(7).
  252. Settting the F register will get you some additional experimental
  253. indexing:
  254.  
  255.     troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ...
  256.  
  257. The indexing merely outputs messages via C<.tm> for each
  258. major page, section, subsection, item, and any C<XE<lt>E<gt>>
  259. directives.
  260.  
  261.  
  262. =head1 RESTRICTIONS
  263.  
  264. None at this time.
  265.  
  266. =head1 BUGS
  267.  
  268. The =over and =back directives don't really work right.  They
  269. take absolute positions instead of offsets, don't nest well, and
  270. making people count is suboptimal in any event.
  271.  
  272. =head1 AUTHORS
  273.  
  274. Original prototype by Larry Wall, but so massively hacked over by
  275. Tom Christiansen such that Larry probably doesn't recognize it anymore.
  276.  
  277. =cut
  278.  
  279. $/ = "";
  280. $cutting = 1;
  281. @Indices = ();
  282.  
  283. # We try first to get the version number from a local binary, in case we're
  284. # running an installed version of Perl to produce documentation from an
  285. # uninstalled newer version's pod files.
  286. if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
  287.   ($version,$patch) =
  288.     `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
  289. }
  290. # No luck; we'll just go with the running Perl's version
  291. ($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
  292. $DEF_RELEASE  = "perl $version";
  293. $DEF_RELEASE .= ", patch $patch" if $patch;
  294.  
  295.  
  296. sub makedate {
  297.     my $secs = shift;
  298.     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
  299.     my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
  300.     return "$mday/$mname/$year";
  301. }
  302.  
  303. use Getopt::Long;
  304.  
  305. $DEF_SECTION = 1;
  306. $DEF_CENTER = "User Contributed Perl Documentation";
  307. $STD_CENTER = "Perl Programmers Reference Guide";
  308. $DEF_FIXED = 'CW';
  309. $DEF_LAX = 0;
  310.  
  311. sub usage {
  312.     warn "$0: @_\n" if @_;
  313.     die <<EOF;
  314. usage: $0 [options] podpage
  315. Options are:
  316.     --section=manext      (default "$DEF_SECTION")
  317.     --release=relpatch    (default "$DEF_RELEASE")
  318.     --center=string       (default "$DEF_CENTER")
  319.     --date=string         (default "$DEF_DATE")
  320.     --fixed=font          (default "$DEF_FIXED")
  321.     --official          (default NOT)
  322.     --lax                 (default NOT)
  323. EOF
  324. }
  325.  
  326. $uok = GetOptions( qw(
  327.     section=s
  328.     release=s
  329.     center=s
  330.     date=s
  331.     fixed=s
  332.     official
  333.     lax
  334.     help));
  335.  
  336. $DEF_DATE = makedate((stat($ARGV[0]))[9] || time());
  337.  
  338. usage("Usage error!") unless $uok;
  339. usage() if $opt_help;
  340. usage("Need one and only one podpage argument") unless @ARGV == 1;
  341.  
  342. $section = $opt_section || ($ARGV[0] =~ /\.pm$/
  343.                 ? $DEF_PM_SECTION : $DEF_SECTION);
  344. $RP = $opt_release || $DEF_RELEASE;
  345. $center = $opt_center || ($opt_official ? $STD_CENTER : $DEF_CENTER);
  346. $lax = $opt_lax || $DEF_LAX;
  347.  
  348. $CFont = $opt_fixed || $DEF_FIXED;
  349.  
  350. if (length($CFont) == 2) {
  351.     $CFont_embed = "\\f($CFont";
  352. }
  353. elsif (length($CFont) == 1) {
  354.     $CFont_embed = "\\f$CFont";
  355. }
  356. else {
  357.     die "roff font should be 1 or 2 chars, not `$CFont_embed'";
  358. }
  359.  
  360. $date = $opt_date || $DEF_DATE;
  361.  
  362. for (qw{NAME DESCRIPTION}) {
  363. # for (qw{NAME DESCRIPTION AUTHOR}) {
  364.     $wanna_see{$_}++;
  365. }
  366. $wanna_see{SYNOPSIS}++ if $section =~ /^3/;
  367.  
  368.  
  369. $name = @ARGV ? $ARGV[0] : "<STDIN>";
  370. $Filename = $name;
  371. if ($section =~ /^1/) {
  372.     require File::Basename;
  373.     $name = uc File::Basename::basename($name);
  374. }
  375. $name =~ s/\.(pod|p[lm])$//i;
  376.  
  377. # Lose everything up to the first of
  378. #     */lib/*perl*    standard or site_perl module
  379. #     */*perl*/lib    from -D prefix=/opt/perl
  380. #     */*perl*/        random module hierarchy
  381. # which works.
  382. $name =~ s-//+-/-g;
  383. if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i
  384.     or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i
  385.     or $name =~ s-^.*?/[^/]*perl[^/]*/--i) {
  386.     # Lose ^site(_perl)?/.
  387.     $name =~ s-^site(_perl)?/--;
  388.     # Lose ^arch/.    (XXX should we use Config? Just for archname?)
  389.     $name =~ s~^(.*-$^O|$^O-.*)/~~o;
  390.     # Lose ^version/.
  391.     $name =~ s-^\d+\.\d+/--;
  392. }
  393.  
  394. # Translate Getopt/Long to Getopt::Long, etc.
  395. $name =~ s(/)(::)g;
  396.  
  397. if ($name ne 'something') {
  398.     FCHECK: {
  399.     open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!";
  400.     while (<F>) {
  401.         next unless /^=\b/;
  402.         if (/^=head1\s+NAME\s*$/) {  # an /m would forgive mistakes
  403.         $_ = <F>;
  404.         unless (/\s*-+\s+/) {
  405.             $oops++;
  406.             warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n"
  407.                 } else {
  408.             my @n = split /\s+-+\s+/;
  409.             if (@n != 2) {
  410.             $oops++;
  411.             warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n"
  412.             }
  413.             else {
  414.             %namedesc = @n;
  415.             }
  416.         }
  417.         last FCHECK;
  418.         }
  419.         next if /^=cut\b/;    # DB_File and Net::Ping have =cut before NAME
  420.         next if /^=pod\b/;  # It is OK to have =pod before NAME
  421.         die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax;
  422.     }
  423.     die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax;
  424.     }
  425.     close F;
  426. }
  427.  
  428. print <<"END";
  429. .rn '' }`
  430. ''' \$RCSfile\$\$Revision\$\$Date\$
  431. '''
  432. ''' \$Log\$
  433. '''
  434. .de Sh
  435. .br
  436. .if t .Sp
  437. .ne 5
  438. .PP
  439. \\fB\\\\\$1\\fR
  440. .PP
  441. ..
  442. .de Sp
  443. .if t .sp .5v
  444. .if n .sp
  445. ..
  446. .de Ip
  447. .br
  448. .ie \\\\n(.\$>=3 .ne \\\\\$3
  449. .el .ne 3
  450. .IP "\\\\\$1" \\\\\$2
  451. ..
  452. .de Vb
  453. .ft $CFont
  454. .nf
  455. .ne \\\\\$1
  456. ..
  457. .de Ve
  458. .ft R
  459.  
  460. .fi
  461. ..
  462. '''
  463. '''
  464. '''     Set up \\*(-- to give an unbreakable dash;
  465. '''     string Tr holds user defined translation string.
  466. '''     Bell System Logo is used as a dummy character.
  467. '''
  468. .tr \\(*W-|\\(bv\\*(Tr
  469. .ie n \\{\\
  470. .ds -- \\(*W-
  471. .ds PI pi
  472. .if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch
  473. .if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch
  474. .ds L" ""
  475. .ds R" ""
  476. '''   \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of
  477. '''   \\*(L" and \\*(R", except that they are used on ".xx" lines,
  478. '''   such as .IP and .SH, which do another additional levels of
  479. '''   double-quote interpretation
  480. .ds M" """
  481. .ds S" """
  482. .ds N" """""
  483. .ds T" """""
  484. .ds L' '
  485. .ds R' '
  486. .ds M' '
  487. .ds S' '
  488. .ds N' '
  489. .ds T' '
  490. 'br\\}
  491. .el\\{\\
  492. .ds -- \\(em\\|
  493. .tr \\*(Tr
  494. .ds L" ``
  495. .ds R" ''
  496. .ds M" ``
  497. .ds S" ''
  498. .ds N" ``
  499. .ds T" ''
  500. .ds L' `
  501. .ds R' '
  502. .ds M' `
  503. .ds S' '
  504. .ds N' `
  505. .ds T' '
  506. .ds PI \\(*p
  507. 'br\\}
  508. END
  509.  
  510. print <<'END';
  511. .\"    If the F register is turned on, we'll generate
  512. .\"    index entries out stderr for the following things:
  513. .\"        TH    Title 
  514. .\"        SH    Header
  515. .\"        Sh    Subsection 
  516. .\"        Ip    Item
  517. .\"        X<>    Xref  (embedded
  518. .\"    Of course, you have to process the output yourself
  519. .\"    in some meaninful fashion.
  520. .if \nF \{
  521. .de IX
  522. .tm Index:\\$1\t\\n%\t"\\$2"
  523. ..
  524. .nr % 0
  525. .rr F
  526. .\}
  527. END
  528.  
  529. print <<"END";
  530. .TH $name $section "$RP" "$date" "$center"
  531. .UC
  532. END
  533.  
  534. push(@Indices, qq{.IX Title "$name $section"});
  535.  
  536. while (($name, $desc) = each %namedesc) {
  537.     for ($name, $desc) { s/^\s+//; s/\s+$//; }
  538.     push(@Indices, qq(.IX Name "$name - $desc"\n));
  539. }
  540.  
  541. print <<'END';
  542. .if n .hy 0
  543. .if n .na
  544. .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
  545. .de CQ          \" put $1 in typewriter font
  546. END
  547. print ".ft $CFont\n";
  548. print <<'END';
  549. 'if n "\c
  550. 'if t \\&\\$1\c
  551. 'if n \\&\\$1\c
  552. 'if n \&"
  553. \\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7
  554. '.ft R
  555. ..
  556. .\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2
  557. .    \" AM - accent mark definitions
  558. .bd B 3
  559. .    \" fudge factors for nroff and troff
  560. .if n \{\
  561. .    ds #H 0
  562. .    ds #V .8m
  563. .    ds #F .3m
  564. .    ds #[ \f1
  565. .    ds #] \fP
  566. .\}
  567. .if t \{\
  568. .    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
  569. .    ds #V .6m
  570. .    ds #F 0
  571. .    ds #[ \&
  572. .    ds #] \&
  573. .\}
  574. .    \" simple accents for nroff and troff
  575. .if n \{\
  576. .    ds ' \&
  577. .    ds ` \&
  578. .    ds ^ \&
  579. .    ds , \&
  580. .    ds ~ ~
  581. .    ds ? ?
  582. .    ds ! !
  583. .    ds /
  584. .    ds q
  585. .\}
  586. .if t \{\
  587. .    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
  588. .    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
  589. .    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
  590. .    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
  591. .    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
  592. .    ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10'
  593. .    ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m'
  594. .    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
  595. .    ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10'
  596. .\}
  597. .    \" troff and (daisy-wheel) nroff accents
  598. .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
  599. .ds 8 \h'\*(#H'\(*b\h'-\*(#H'
  600. .ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#]
  601. .ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u'
  602. .ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u'
  603. .ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#]
  604. .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
  605. .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
  606. .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
  607. .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
  608. .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
  609. .ds ae a\h'-(\w'a'u*4/10)'e
  610. .ds Ae A\h'-(\w'A'u*4/10)'E
  611. .ds oe o\h'-(\w'o'u*4/10)'e
  612. .ds Oe O\h'-(\w'O'u*4/10)'E
  613. .    \" corrections for vroff
  614. .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
  615. .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
  616. .    \" for low resolution devices (crt and lpr)
  617. .if \n(.H>23 .if \n(.V>19 \
  618. \{\
  619. .    ds : e
  620. .    ds 8 ss
  621. .    ds v \h'-1'\o'\(aa\(ga'
  622. .    ds _ \h'-1'^
  623. .    ds . \h'-1'.
  624. .    ds 3 3
  625. .    ds o a
  626. .    ds d- d\h'-1'\(ga
  627. .    ds D- D\h'-1'\(hy
  628. .    ds th \o'bp'
  629. .    ds Th \o'LP'
  630. .    ds ae ae
  631. .    ds Ae AE
  632. .    ds oe oe
  633. .    ds Oe OE
  634. .\}
  635. .rm #[ #] #H #V #F C
  636. END
  637.  
  638. $indent = 0;
  639.  
  640. $begun = "";
  641.  
  642. # Unrolling [^A-Z>]|[A-Z](?!<) gives:    // MRE pp 165.
  643. my $nonest = '(?:[^A-Z>]*(?:[A-Z](?!<)[^A-Z>]*)*)';
  644.  
  645. while (<>) {
  646.     if ($cutting) {
  647.     next unless /^=/;
  648.     $cutting = 0;
  649.     }
  650.     if ($begun) {
  651.     if (/^=end\s+$begun/) {
  652.             $begun = "";
  653.     }
  654.     elsif ($begun =~ /^(roff|man)$/) {
  655.         print STDOUT $_;
  656.         }
  657.     next;
  658.     }
  659.     chomp;
  660.  
  661.     # Translate verbatim paragraph
  662.  
  663.     if (/^\s/) {
  664.     @lines = split(/\n/);
  665.     for (@lines) {
  666.         1 while s
  667.         {^( [^\t]* ) \t ( \t* ) }
  668.         { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex;
  669.         s/\\/\\e/g;
  670.         s/\A/\\&/s;
  671.     }
  672.     $lines = @lines;
  673.     makespace() unless $verbatim++;
  674.     print ".Vb $lines\n";
  675.     print join("\n", @lines), "\n";
  676.     print ".Ve\n";
  677.     $needspace = 0;
  678.     next;
  679.     }
  680.  
  681.     $verbatim = 0;
  682.  
  683.     if (/^=for\s+(\S+)\s*/s) {
  684.     if ($1 eq "man" or $1 eq "roff") {
  685.         print STDOUT $',"\n\n";
  686.     } else {
  687.         # ignore unknown for
  688.     }
  689.     next;
  690.     }
  691.     elsif (/^=begin\s+(\S+)\s*/s) {
  692.     $begun = $1;
  693.     if ($1 eq "man" or $1 eq "roff") {
  694.         print STDOUT $'."\n\n";
  695.     }
  696.     next;
  697.     }
  698.  
  699.     # check for things that'll hosed our noremap scheme; affects $_
  700.     init_noremap();
  701.  
  702.     if (!/^=item/) {
  703.  
  704.     # trofficate backslashes; must do it before what happens below
  705.     s/\\/noremap('\\e')/ge;
  706.  
  707.     # protect leading periods and quotes against *roff
  708.     # mistaking them for directives
  709.     s/^(?:[A-Z]<)?[.']/\\&$&/gm;
  710.  
  711.     # first hide the escapes in case we need to
  712.     # intuit something and get it wrong due to fmting
  713.  
  714.     1 while s/([A-Z]<$nonest>)/noremap($1)/ge;
  715.  
  716.     # func() is a reference to a perl function
  717.     s{
  718.         \b
  719.         (
  720.         [:\w]+ \(\)
  721.         )
  722.     } {I<$1>}gx;
  723.  
  724.     # func(n) is a reference to a perl function or a man page
  725.     s{
  726.         ([:\w]+)
  727.         (
  728.         \( [^\051]+ \)
  729.         )
  730.     } {I<$1>\\|$2}gx;
  731.  
  732.     # convert simple variable references
  733.     s/(\s+)([\$\@%][\w:]+)(?!\()/${1}C<$2>/g;
  734.  
  735.     if (m{ (
  736.             [\-\w]+
  737.             \(
  738.             [^\051]*?
  739.             [\@\$,]
  740.             [^\051]*?
  741.             \)
  742.         )
  743.         }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/)
  744.     {
  745.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n";
  746.         $oops++;
  747.     }
  748.  
  749.     while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) {
  750.         warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n";
  751.         $oops++;
  752.     }
  753.  
  754.     # put it back so we get the <> processed again;
  755.     clear_noremap(0); # 0 means leave the E's
  756.  
  757.     } else {
  758.     # trofficate backslashes
  759.     s/\\/noremap('\\e')/ge;
  760.  
  761.     }
  762.  
  763.     # need to hide E<> first; they're processed in clear_noremap
  764.     s/(E<[^<>]+>)/noremap($1)/ge;
  765.  
  766.  
  767.     $maxnest = 10;
  768.     while ($maxnest-- && /[A-Z]</) {
  769.  
  770.     # can't do C font here
  771.     s/([BI])<($nonest)>/font($1) . $2 . font('R')/eg;
  772.  
  773.     # files and filelike refs in italics
  774.     s/F<($nonest)>/I<$1>/g;
  775.  
  776.     # no break -- usually we want C<> for this
  777.     s/S<($nonest)>/nobreak($1)/eg;
  778.  
  779.     # LREF: a la HREF L<show this text|man/section>
  780.     s:L<([^|>]+)\|[^>]+>:$1:g;
  781.  
  782.     # LREF: a manpage(3f)
  783.     s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g;
  784.  
  785.     # LREF: an =item on another manpage
  786.     s{
  787.         L<
  788.         ([^/]+)
  789.         /
  790.         (
  791.             [:\w]+
  792.             (\(\))?
  793.         )
  794.         >
  795.     } {the C<$2> entry in the I<$1> manpage}gx;
  796.  
  797.     # LREF: an =item on this manpage
  798.     s{
  799.        ((?:
  800.         L<
  801.         /
  802.         (
  803.             [:\w]+
  804.             (\(\))?
  805.         )
  806.         >
  807.         (,?\s+(and\s+)?)?
  808.       )+)
  809.     } { internal_lrefs($1) }gex;
  810.  
  811.     # LREF: a =head2 (head1?), maybe on a manpage, maybe right here
  812.     # the "func" can disambiguate
  813.     s{
  814.         L<
  815.         (?:
  816.             ([a-zA-Z]\S+?) /
  817.         )?
  818.         "?(.*?)"?
  819.         >
  820.     }{
  821.         do {
  822.         $1     # if no $1, assume it means on this page.
  823.             ?  "the section on I<$2> in the I<$1> manpage"
  824.             :  "the section on I<$2>"
  825.         }
  826.     }gesx; # s in case it goes over multiple lines, so . matches \n
  827.  
  828.     s/Z<>/\\&/g;
  829.  
  830.     # comes last because not subject to reprocessing
  831.     s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg;
  832.     }
  833.  
  834.     if (s/^=//) {
  835.     $needspace = 0;        # Assume this.
  836.  
  837.     s/\n/ /g;
  838.  
  839.     ($Cmd, $_) = split(' ', $_, 2);
  840.  
  841.     $dotlevel = 1;
  842.     if ($Cmd eq 'head1') {
  843.        $dotlevel = 1;
  844.     }
  845.     elsif ($Cmd eq 'head2') {
  846.        $dotlevel = 1;
  847.     }
  848.     elsif ($Cmd eq 'item') {
  849.        $dotlevel = 2;
  850.     }
  851.  
  852.     if (defined $_) {
  853.         &escapes($dotlevel);
  854.         s/"/""/g;
  855.     }
  856.  
  857.     clear_noremap(1);
  858.  
  859.     if ($Cmd eq 'cut') {
  860.         $cutting = 1;
  861.     }
  862.     elsif ($Cmd eq 'head1') {
  863.         s/\s+$//;
  864.         delete $wanna_see{$_} if exists $wanna_see{$_};
  865.         print qq{.SH "$_"\n};
  866.       push(@Indices, qq{.IX Header "$_"\n});
  867.     }
  868.     elsif ($Cmd eq 'head2') {
  869.         print qq{.Sh "$_"\n};
  870.       push(@Indices, qq{.IX Subsection "$_"\n});
  871.     }
  872.     elsif ($Cmd eq 'over') {
  873.         push(@indent,$indent);
  874.         $indent += ($_ + 0) || 5;
  875.     }
  876.     elsif ($Cmd eq 'back') {
  877.         $indent = pop(@indent);
  878.         warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent;
  879.         $needspace = 1;
  880.     }
  881.     elsif ($Cmd eq 'item') {
  882.         s/^\*( |$)/\\(bu$1/g;
  883.         # if you know how to get ":s please do
  884.         s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g;
  885.         s/\\\*\(L"([^"]+?)""/'$1'/g;
  886.         s/[^"]""([^"]+?)""[^"]/'$1'/g;
  887.         # here do something about the $" in perlvar?
  888.         print STDOUT qq{.Ip "$_" $indent\n};
  889.       push(@Indices, qq{.IX Item "$_"\n});
  890.     }
  891.     elsif ($Cmd eq 'pod') {
  892.         # this is just a comment
  893.     } 
  894.     else {
  895.         warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n";
  896.     }
  897.     }
  898.     else {
  899.     if ($needspace) {
  900.         &makespace;
  901.     }
  902.     &escapes(0);
  903.     clear_noremap(1);
  904.     print $_, "\n";
  905.     $needspace = 1;
  906.     }
  907. }
  908.  
  909. print <<"END";
  910.  
  911. .rn }` ''
  912. END
  913.  
  914. if (%wanna_see && !$lax) {
  915.     @missing = keys %wanna_see;
  916.     warn "$0: $Filename is missing required section"
  917.     .  (@missing > 1 && "s")
  918.     .  ": @missing\n";
  919.     $oops++;
  920. }
  921.  
  922. foreach (@Indices) { print "$_\n"; }
  923.  
  924. exit;
  925. #exit ($oops != 0);
  926.  
  927. #########################################################################
  928.  
  929. sub nobreak {
  930.     my $string = shift;
  931.     $string =~ s/ /\\ /g;
  932.     $string;
  933. }
  934.  
  935. sub escapes {
  936.     my $indot = shift;
  937.  
  938.     s/X<(.*?)>/mkindex($1)/ge;
  939.  
  940.     # translate the minus in foo-bar into foo\-bar for roff
  941.     s/([^0-9a-z-])-([^-])/$1\\-$2/g;
  942.  
  943.     # make -- into the string version \*(-- (defined above)
  944.     s/\b--\b/\\*(--/g;
  945.     s/"--([^"])/"\\*(--$1/g;  # should be a better way
  946.     s/([^"])--"/$1\\*(--"/g;
  947.  
  948.     # fix up quotes; this is somewhat tricky
  949.     my $dotmacroL = 'L';
  950.     my $dotmacroR = 'R';
  951.     if ( $indot == 1 ) {
  952.     $dotmacroL = 'M';
  953.     $dotmacroR = 'S';
  954.     }  
  955.     elsif ( $indot >= 2 ) {
  956.     $dotmacroL = 'N';
  957.     $dotmacroR = 'T';
  958.     }  
  959.     if (!/""/) {
  960.     s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge;
  961.     s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge;
  962.     }
  963.  
  964.     #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g;
  965.     #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g;
  966.  
  967.  
  968.     # make sure that func() keeps a bit a space tween the parens
  969.     ### s/\b\(\)/\\|()/g;
  970.     ### s/\b\(\)/(\\|)/g;
  971.  
  972.     # make C++ into \*C+, which is a squinched version (defined above)
  973.     s/\bC\+\+/\\*(C+/g;
  974.  
  975.     # make double underbars have a little tiny space between them
  976.     s/__/_\\|_/g;
  977.  
  978.     # PI goes to \*(PI (defined above)
  979.     s/\bPI\b/noremap('\\*(PI')/ge;
  980.  
  981.     # make all caps a teeny bit smaller, but don't muck with embedded code literals
  982.     my $hidCFont = font('C');
  983.     if ($Cmd !~ /^head1/) { # SH already makes smaller
  984.     # /g isn't enough; 1 while or we'll be off
  985.  
  986. #    1 while s{
  987. #        (?!$hidCFont)(..|^.|^)
  988. #        \b
  989. #        (
  990. #        [A-Z][\/A-Z+:\-\d_$.]+
  991. #        )
  992. #        (s?)         
  993. #        \b
  994. #    } {$1\\s-1$2\\s0}gmox;
  995.  
  996.     1 while s{
  997.         (?!$hidCFont)(..|^.|^)
  998.         (
  999.         \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b
  1000.         )
  1001.     } {
  1002.         $1 . noremap( '\\s-1' .  $2 . '\\s0' )
  1003.     }egmox;
  1004.  
  1005.     }
  1006. }
  1007.  
  1008. # make troff just be normal, but make small nroff get quoted
  1009. # decided to just put the quotes in the text; sigh;
  1010. sub ccvt {
  1011.     local($_,$prev) = @_;
  1012.     noremap(qq{.CQ "$_" \n\\&});
  1013. }
  1014.  
  1015. sub makespace {
  1016.     if ($indent) {
  1017.     print ".Sp\n";
  1018.     }
  1019.     else {
  1020.     print ".PP\n";
  1021.     }
  1022. }
  1023.  
  1024. sub mkindex {
  1025.     my ($entry) = @_;
  1026.     my @entries = split m:\s*/\s*:, $entry;
  1027.     push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries;
  1028.     return '';
  1029. }
  1030.  
  1031. sub font {
  1032.     local($font) = shift;
  1033.     return '\\f' . noremap($font);
  1034. }
  1035.  
  1036. sub noremap {
  1037.     local($thing_to_hide) = shift;
  1038.     $thing_to_hide =~ tr/\000-\177/\200-\377/;
  1039.     return $thing_to_hide;
  1040. }
  1041.  
  1042. sub init_noremap {
  1043.     # escape high bit characters in input stream
  1044.     s/([\200-\377])/"E<".ord($1).">"/ge;
  1045. }
  1046.  
  1047. sub clear_noremap {
  1048.     my $ready_to_print = $_[0];
  1049.  
  1050.     tr/\200-\377/\000-\177/;
  1051.  
  1052.     # trofficate backslashes
  1053.     # s/(?!\\e)(?:..|^.|^)\\/\\e/g;
  1054.  
  1055.     # now for the E<>s, which have been hidden until now
  1056.     # otherwise the interative \w<> processing would have
  1057.     # been hosed by the E<gt>
  1058.     s {
  1059.         E<
  1060.         (
  1061.             ( \d + ) 
  1062.             | ( [A-Za-z]+ )    
  1063.         )
  1064.         >    
  1065.     } {
  1066.      do {
  1067.          defined $2
  1068.         ? chr($2)
  1069.         :    
  1070.          exists $HTML_Escapes{$3}
  1071.         ? do { $HTML_Escapes{$3} }
  1072.         : do {
  1073.             warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n";
  1074.             "E<$1>";
  1075.         }
  1076.      }
  1077.     }egx if $ready_to_print;
  1078. }
  1079.  
  1080. sub internal_lrefs {
  1081.     local($_) = shift;
  1082.     local $trailing_and = s/and\s+$// ? "and " : "";
  1083.  
  1084.     s{L</([^>]+)>}{$1}g;
  1085.     my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
  1086.     my $retstr = "the ";
  1087.     my $i;
  1088.     for ($i = 0; $i <= $#items; $i++) {
  1089.     $retstr .= "C<$items[$i]>";
  1090.     $retstr .= ", " if @items > 2 && $i != $#items;
  1091.     $retstr .= " and " if $i+2 == @items;
  1092.     }
  1093.  
  1094.     $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
  1095.         .  " elsewhere in this document";
  1096.     # terminal space to avoid words running together (pattern used
  1097.     # strips terminal spaces)
  1098.     $retstr .= " " if length $trailing_and;
  1099.     $retstr .=  $trailing_and;
  1100.  
  1101.     return $retstr;
  1102.  
  1103. }
  1104.  
  1105. BEGIN {
  1106. %HTML_Escapes = (
  1107.     'amp'    =>    '&',    #   ampersand
  1108.     'lt'    =>    '<',    #   left chevron, less-than
  1109.     'gt'    =>    '>',    #   right chevron, greater-than
  1110.     'quot'    =>    '"',    #   double quote
  1111.  
  1112.     "Aacute"    =>    "A\\*'",    #   capital A, acute accent
  1113.     "aacute"    =>    "a\\*'",    #   small a, acute accent
  1114.     "Acirc"    =>    "A\\*^",    #   capital A, circumflex accent
  1115.     "acirc"    =>    "a\\*^",    #   small a, circumflex accent
  1116.     "AElig"    =>    '\*(AE',    #   capital AE diphthong (ligature)
  1117.     "aelig"    =>    '\*(ae',    #   small ae diphthong (ligature)
  1118.     "Agrave"    =>    "A\\*`",    #   capital A, grave accent
  1119.     "agrave"    =>    "A\\*`",    #   small a, grave accent
  1120.     "Aring"    =>    'A\\*o',    #   capital A, ring
  1121.     "aring"    =>    'a\\*o',    #   small a, ring
  1122.     "Atilde"    =>    'A\\*~',    #   capital A, tilde
  1123.     "atilde"    =>    'a\\*~',    #   small a, tilde
  1124.     "Auml"    =>    'A\\*:',    #   capital A, dieresis or umlaut mark
  1125.     "auml"    =>    'a\\*:',    #   small a, dieresis or umlaut mark
  1126.     "Ccedil"    =>    'C\\*,',    #   capital C, cedilla
  1127.     "ccedil"    =>    'c\\*,',    #   small c, cedilla
  1128.     "Eacute"    =>    "E\\*'",    #   capital E, acute accent
  1129.     "eacute"    =>    "e\\*'",    #   small e, acute accent
  1130.     "Ecirc"    =>    "E\\*^",    #   capital E, circumflex accent
  1131.     "ecirc"    =>    "e\\*^",    #   small e, circumflex accent
  1132.     "Egrave"    =>    "E\\*`",    #   capital E, grave accent
  1133.     "egrave"    =>    "e\\*`",    #   small e, grave accent
  1134.     "ETH"    =>    '\\*(D-',    #   capital Eth, Icelandic
  1135.     "eth"    =>    '\\*(d-',    #   small eth, Icelandic
  1136.     "Euml"    =>    "E\\*:",    #   capital E, dieresis or umlaut mark
  1137.     "euml"    =>    "e\\*:",    #   small e, dieresis or umlaut mark
  1138.     "Iacute"    =>    "I\\*'",    #   capital I, acute accent
  1139.     "iacute"    =>    "i\\*'",    #   small i, acute accent
  1140.     "Icirc"    =>    "I\\*^",    #   capital I, circumflex accent
  1141.     "icirc"    =>    "i\\*^",    #   small i, circumflex accent
  1142.     "Igrave"    =>    "I\\*`",    #   capital I, grave accent
  1143.     "igrave"    =>    "i\\*`",    #   small i, grave accent
  1144.     "Iuml"    =>    "I\\*:",    #   capital I, dieresis or umlaut mark
  1145.     "iuml"    =>    "i\\*:",    #   small i, dieresis or umlaut mark
  1146.     "Ntilde"    =>    'N\*~',        #   capital N, tilde
  1147.     "ntilde"    =>    'n\*~',        #   small n, tilde
  1148.     "Oacute"    =>    "O\\*'",    #   capital O, acute accent
  1149.     "oacute"    =>    "o\\*'",    #   small o, acute accent
  1150.     "Ocirc"    =>    "O\\*^",    #   capital O, circumflex accent
  1151.     "ocirc"    =>    "o\\*^",    #   small o, circumflex accent
  1152.     "Ograve"    =>    "O\\*`",    #   capital O, grave accent
  1153.     "ograve"    =>    "o\\*`",    #   small o, grave accent
  1154.     "Oslash"    =>    "O\\*/",    #   capital O, slash
  1155.     "oslash"    =>    "o\\*/",    #   small o, slash
  1156.     "Otilde"    =>    "O\\*~",    #   capital O, tilde
  1157.     "otilde"    =>    "o\\*~",    #   small o, tilde
  1158.     "Ouml"    =>    "O\\*:",    #   capital O, dieresis or umlaut mark
  1159.     "ouml"    =>    "o\\*:",    #   small o, dieresis or umlaut mark
  1160.     "szlig"    =>    '\*8',        #   small sharp s, German (sz ligature)
  1161.     "THORN"    =>    '\\*(Th',    #   capital THORN, Icelandic
  1162.     "thorn"    =>    '\\*(th',,    #   small thorn, Icelandic
  1163.     "Uacute"    =>    "U\\*'",    #   capital U, acute accent
  1164.     "uacute"    =>    "u\\*'",    #   small u, acute accent
  1165.     "Ucirc"    =>    "U\\*^",    #   capital U, circumflex accent
  1166.     "ucirc"    =>    "u\\*^",    #   small u, circumflex accent
  1167.     "Ugrave"    =>    "U\\*`",    #   capital U, grave accent
  1168.     "ugrave"    =>    "u\\*`",    #   small u, grave accent
  1169.     "Uuml"    =>    "U\\*:",    #   capital U, dieresis or umlaut mark
  1170.     "uuml"    =>    "u\\*:",    #   small u, dieresis or umlaut mark
  1171.     "Yacute"    =>    "Y\\*'",    #   capital Y, acute accent
  1172.     "yacute"    =>    "y\\*'",    #   small y, acute accent
  1173.     "yuml"    =>    "y\\*:",    #   small y, dieresis or umlaut mark
  1174. );
  1175. }
  1176.  
  1177.